home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / magicfsm.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  12.9 KB  |  447 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *         MAGIC   Modula's  All purpose  GEM  Interface  Cadre         *
  4.  *                 ÿ         ÿ            ÿ    ÿ          ÿ             *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus in schrift-  *
  11.  * licher Form, insbesondere in Zeitschriften, sowie die Verbreitung    *
  12.  * ber Public-Domain-H„ndler bedarf der ausdrcklichen schriftlichen   *
  13.  * Genehmigung des Autors!                                              *
  14.  *                                                                      *
  15.  * Der Autor gibt hiermit die ausdrckliche Erlaubnis, das Modul jeder- *
  16.  * zeit auch im Quelltext weiterzugegeben, sofern dessen Text und ins-  *
  17.  * besondere dieser Urheberrechts-Vermerk nicht ver„ndert wird, und     *
  18.  * durch die Weitergabe kein finanzieller Nutzen entsteht. Der Autor    *
  19.  * beh„lt sich das Recht vor, diese Erlaubnis jederzeit u. ohne Angaben *
  20.  * von Grnden zu widerrufen.                                           *
  21.  *----------------------------------------------------------------------*)
  22.  
  23. IMPLEMENTATION MODULE MagicFSM;
  24.  
  25. (*----------------------------------------------------------------------*
  26.  * Int. Vers | Datum    | Name | Žnderung                               *
  27.  *-----------+----------+------+----------------------------------------*
  28.  *  1.00     | 02.02.92 |  Hp  |                                        *
  29.  *-----------+----------+------+----------------------------------------*)
  30.  
  31.  
  32.  
  33. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  34. (*                                              *)
  35. (*$R-   Range-Checks                            *)
  36. (*$S-   Stack-Check                             *)
  37. (*                                              *)
  38. (*----------------------------------------------*)
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  46.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  47.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  48.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  49.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  50.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  51.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  52.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59. IMPORT SYSTEM, MagicSys;
  60. FROM MagicVDI   IMPORT  VDIIntIn, VDIIntOut, VDIPtsIn, VDIPtsOut, 
  61.                         VDIControl, VDICall, VDIPB;
  62.  
  63.  
  64. VAR array: POINTER TO ARRAY [0..255] OF sINTEGER;
  65.  
  66.  
  67. PROCEDURE InqFacename (handle, element: sINTEGER; 
  68.                        VAR name: ARRAY OF CHAR; VAR fsm: BOOLEAN): sINTEGER;
  69. VAR i: sINTEGER;
  70. BEGIN
  71.  VDIIntIn[0]:= element;
  72.  VDIIntOut[33] := 0;
  73.  VDICall (130, 0, 1, 0, handle);
  74.  FOR i:= 1 TO 32 DO name[i-1]:= CHR(VDIIntOut[i]) END;
  75.  IF HIGH (name) >= 32 THEN name[32] := 0C; END;
  76.  fsm:= (VDIControl[4] >= 34) & (VDIIntOut[33] = 1);
  77.  RETURN VDIIntOut[0];
  78. END InqFacename;
  79.  
  80. PROCEDURE fillIntin (REF string: ARRAY OF CHAR; VAR adr: SYSTEM.ADDRESS; VAR len: sCARDINAL);
  81. (* Fllt das IntIn-Array, alloziert ggf. einen neuen Speicherblock
  82.  * dafr und gibt die Adresse zurck 
  83.  *)
  84.  VAR h : sCARDINAL;
  85.      c : sCARDINAL;
  86.      a : SYSTEM.ADDRESS;
  87. BEGIN
  88.  h:= HIGH(string);
  89.  SYSTEM.ASSEMBLER
  90.    MOVEQ        #0,D0
  91.    MOVE.W       h(A6),D1
  92.    MOVEQ        #0,D2
  93.    MOVE.L       string(A6),A0
  94.    LEA          VDIIntIn,A1
  95.    MOVE.L       A1,a(A6)
  96.  loop:
  97.    MOVE.B       (A0)+,D2
  98.    MOVE.W       D2,(A1)+
  99.    BEQ.S        exit
  100.    ADDQ.W       #1,D0
  101.    CMPI.W       #512,D0     (* VDIIntIn voll? *)
  102.    BEQ.S        mist
  103.    SUBQ.W       #1,D1
  104.    BNE.S        loop
  105.   exit:
  106.    BRA.S        end
  107.   mist:
  108.    ; Jetzt erstmal die L„nge feststellen 
  109.    MOVE.L       A0,A2
  110.    MOVE.W       D0,D2
  111.   lm:
  112.    ADDQ.W       #1,D2
  113.    TST.B        (A2)+
  114.    BNE.S        lm
  115.   lmend:
  116.    ; L„nge steht nun in D2
  117.    ; Speicher fr neues VDIIntIn beim GEMDOS anfordern 
  118.    MOVEM.L      D0-D1/A0-A1/A3-A6,-(SP)
  119.    LSL.W        #1,D2           ; * 2 fr Integer
  120.    MOVE.L       D2,-(SP)
  121.    MOVE.W       #72, -(SP)
  122.    TRAP         #1
  123.    ADDQ.L       #6, SP
  124.    MOVE.L       D0,A2
  125.    BEQ.S        fail            ; kein Speicher mehr frei! Wir machen ganu normal weiter
  126.    MOVE.L       D0,a(A6)
  127.    MOVEM.L      (SP)+,D0-D1/A0-A1/A3-A6
  128.    ; Jetzt VDIIntIn nochmal kopieren
  129.    LEA          VDIIntIn,A1
  130.    MOVE.W       D0,D2
  131.    SUBQ.W       #1,D2
  132.   lm2:
  133.    MOVE.W       (A1)+,(A2)+
  134.    DBRA         D2, lm2
  135.    ; So, jetzt ist das Array kopiert. 
  136.    ; Jetzt mssen wir noch ein paar Register wiederherstellen und k”nnen dann in Loop
  137.    ; weitermachen
  138.    MOVE.L       A2,A1
  139.   fail:
  140.    MOVEQ        #0,D2
  141.    SUBQ.W       #1,D1
  142.    BNE.S        loop
  143.   end:
  144.    MOVE.W       D0,c(A6)
  145.  END;
  146.  adr := a;
  147.  len := c;
  148. END fillIntin;
  149.  
  150. PROCEDURE freeIntin (a: SYSTEM.ADDRESS);
  151. BEGIN
  152.  SYSTEM.ASSEMBLER
  153.    LEA      VDIIntIn,A0
  154.    MOVE.L   a(A6),A1
  155.    CMPA.L   A0,A1
  156.    BEQ.S    exit
  157.    ; Mfree fr a aufrufen
  158.    MOVE.L  A1, -(SP)
  159.    MOVE.W  #73, -(SP)
  160.    TRAP    #1
  161.    ADDQ.L  #6, SP
  162.   exit:
  163.  END;
  164.  VDIPB.intin := SYSTEM.ADR(VDIIntIn);
  165. END freeIntin;
  166.  
  167. PROCEDURE InqFExtent (handle: sINTEGER; REF string: ARRAY OF CHAR;
  168.                       VAR extent: ARRAY OF LOC);
  169. VAR c, h: CARDINAL;
  170.     a: SYSTEM.ADDRESS;
  171. BEGIN
  172.  (*
  173.  c:= 0;  h:= HIGH(string);
  174.  SYSTEM.ASSEMBLER
  175.    MOVEQ        #0,D0
  176.    MOVE.W       h(A6),D1
  177.    MOVEQ        #0,D2
  178.    MOVE.L       string(A6),A0
  179.    LEA          VDIIntIn,A1
  180.  loop:
  181.    MOVE.B       (A0)+,D2
  182.    MOVE.W       D2,(A1)+
  183.    BEQ.S        exit
  184.    ADDQ.W       #1,D0
  185.    SUBQ.W       #1,D1
  186.    BNE.S        loop
  187.   exit:
  188.    MOVE.W       D0,c(A6)
  189.  END;
  190.  (*
  191.  WHILE (c <= h) AND (string[c] # 0C) DO
  192.   VDIIntIn[c]:= ORD(string[c]);  INC(c);
  193.  END;
  194.  *)
  195.  *)
  196.  fillIntin (string, a, c);
  197.  VDIPB.intin := a;
  198.  VDICall (240, 0, c, 0, handle);
  199.  array:= SYSTEM.ADR(extent);
  200.  FOR c:= 0 TO 7 DO  array^[c]:= VDIPtsOut[c]; END;
  201.  freeIntin (a);
  202. END InqFExtent;
  203.  
  204. PROCEDURE FSMText (handle, x, y: sINTEGER; REF string: ARRAY OF CHAR);
  205. VAR c, h: CARDINAL;
  206.     a   : SYSTEM.ADDRESS;
  207. BEGIN
  208.  (*
  209.  c:= 0;  h:= HIGH(string);
  210.  SYSTEM.ASSEMBLER
  211.    MOVEQ        #0,D0
  212.    MOVE.W       h(A6),D1
  213.    MOVEQ        #0,D2
  214.    MOVE.L       string(A6),A0
  215.    LEA          VDIIntIn,A1
  216.  loop:
  217.    MOVE.B       (A0)+,D2
  218.    MOVE.W       D2,(A1)+
  219.    BEQ.S        exit
  220.    ADDQ.W       #1,D0
  221.    SUBQ.W       #1,D1
  222.    BNE.S        loop
  223.   exit:
  224.    MOVE.W       D0,c(A6)
  225.  END;
  226.  (*
  227.  WHILE (c <= h) AND (string[c] # 0C) DO
  228.   VDIIntIn[c]:= ORD(string[c]);  INC(c);
  229.  END;
  230.  *)
  231.  *)
  232.  fillIntin (string, a, c);
  233.  VDIPB.intin := a;
  234.  VDIPtsIn[0]:= x;
  235.  VDIPtsIn[1]:= y;
  236.  VDICall(241, 1, c, 0, handle);
  237.  freeIntin (a);
  238. END FSMText;
  239.  
  240. PROCEDURE KillOutline (handle: sINTEGER; VAR component: ARRAY OF LOC);
  241. VAR trick: POINTER TO SYSTEM.ADDRESS;
  242. BEGIN
  243.  trick:= SYSTEM.ADR (VDIIntIn[0]);
  244.  trick^:= SYSTEM.ADR (component);
  245.  VDICall(242, 0, 2, 0, handle);
  246. END KillOutline;
  247.  
  248. PROCEDURE GetOutline (handle: sINTEGER; ch: CHAR; VAR component: ARRAY OF LOC);
  249. VAR trick: POINTER TO SYSTEM.ADDRESS;
  250. BEGIN
  251.  VDIIntIn[0]:= ORD (ch);
  252.  trick:= SYSTEM.ADR (VDIIntIn[1]);
  253.  trick^:= SYSTEM.ADR (component);
  254.  VDICall(243, 0, 3, 0, handle);
  255. END GetOutline;
  256.  
  257. PROCEDURE SetScratch (handle, mode: sINTEGER);
  258. BEGIN
  259.  VDIIntIn[0]:= mode;
  260.  VDICall(244, 0, 1, 0, handle);
  261. END SetScratch;
  262.  
  263. PROCEDURE SetErrormode (handle, mode: sINTEGER; VAR errorcode: sINTEGER);
  264. VAR trick: POINTER TO SYSTEM.ADDRESS;
  265. BEGIN
  266.  VDIIntIn[0]:= mode;
  267.  trick:= SYSTEM.ADR (VDIIntIn[1]);
  268.  trick^:= SYSTEM.ADR (errorcode);
  269.  VDICall(245, 0, 3, 0, handle);
  270. END SetErrormode;
  271.  
  272. PROCEDURE SetArbpoints (handle, point: sINTEGER; VAR cw, ch, bw, bh: sINTEGER): sINTEGER;
  273. BEGIN
  274.  VDIIntIn[0]:= point;
  275.  VDICall(246, 0, 1, 0, handle);
  276.  cw:= VDIPtsOut[0];
  277.  ch:= VDIPtsOut[1];
  278.  bw:= VDIPtsOut[2];
  279.  bh:= VDIPtsOut[3];
  280.  RETURN VDIIntOut[0];
  281. END SetArbpoints;
  282.  
  283. PROCEDURE InqAdvance (handle: sINTEGER; ch: CHAR; VAR advx, advy, xr, yr: sINTEGER);
  284. BEGIN
  285.  VDIIntIn[0]:= ORD (ch);
  286.  VDICall(247, 0, 1, 0, handle);
  287.  advx:= VDIPtsOut[0];
  288.  advy:= VDIPtsOut[1];
  289.  xr:=   VDIPtsOut[2];
  290.  yr:=   VDIPtsOut[3];
  291. END InqAdvance;
  292.  
  293. PROCEDURE InqDeviceinfo (handle, device: sINTEGER; VAR devstr: ARRAY OF CHAR): BOOLEAN;
  294. VAR l, i: sCARDINAL;
  295.     b: BOOLEAN;
  296. BEGIN
  297.  VDIIntIn[0]:= device;
  298.  VDICall(248, 0, 1, 0, handle);
  299.  l:= CastToCard (VDIControl[4]); 
  300.  IF VDIPtsOut[0] = 1 THEN
  301.   i:= 0;
  302.   LOOP
  303.    IF i > HIGH (devstr) THEN  EXIT;  END;
  304.    IF i > l THEN  EXIT;  END;
  305.    devstr[i]:= CHR (VDIIntOut[i]);  INC (i);
  306.   END;
  307.   IF i < HIGH (devstr) THEN  devstr[i]:= 0C;  END;
  308.   RETURN TRUE;
  309.  ELSE
  310.   devstr[0]:= 0C;
  311.   RETURN FALSE;
  312.  END;
  313. END InqDeviceinfo;
  314.  
  315. PROCEDURE SaveFSMCache (handle: sINTEGER; REF file: ARRAY OF CHAR): sINTEGER;
  316. VAR c, h: sINTEGER;
  317. BEGIN
  318.  c:= 0;  h:= HIGH(file);
  319.  WHILE (c <= h) AND (file[c] # 0C) DO
  320.   VDIIntIn[c]:= ORD(file[c]);  INC(c);
  321.  END;
  322.  VDICall(249, 0, c, 0, handle);
  323.  RETURN VDIIntOut[0];
  324. END SaveFSMCache;
  325.  
  326. PROCEDURE LoadFSMCache (handle: sINTEGER; REF file: ARRAY OF CHAR; mode: sINTEGER): sINTEGER;
  327. VAR c, h: sINTEGER;
  328. BEGIN
  329.  VDIIntIn[0]:= mode;
  330.  c:= 0;  h:= HIGH(file);
  331.  WHILE (c <= h) AND (file[c] # 0C) DO
  332.   VDIIntIn[c + 1]:= ORD(file[c]);  INC(c);
  333.  END;
  334.  VDICall(250, 0, c + 1, 0, handle);
  335.  RETURN VDIIntOut[0];
  336. END LoadFSMCache;
  337.  
  338. PROCEDURE FlushFSMCache (handle: sINTEGER);
  339. BEGIN
  340.  VDICall(251, 0, 0, 0, handle);
  341. END FlushFSMCache;
  342.  
  343. PROCEDURE SetSize (handle, point: sINTEGER; VAR cw, ch, bw, bh: sINTEGER): sINTEGER;
  344. BEGIN
  345.  VDIIntIn[0]:= point;
  346.  VDICall(252, 0, 1, 0, handle);
  347.  cw:= VDIPtsOut[0];
  348.  ch:= VDIPtsOut[1];
  349.  bw:= VDIPtsOut[2];
  350.  bh:= VDIPtsOut[3];
  351.  RETURN VDIIntOut[0];
  352. END SetSize;
  353.  
  354. PROCEDURE SetSkew (handle, skew: sINTEGER): sINTEGER;
  355. BEGIN
  356.  VDIIntIn[0]:= skew;
  357.  VDICall(253, 0, 1, 0, handle);
  358.  RETURN VDIIntOut[0];
  359. END SetSkew;
  360.  
  361. PROCEDURE GetFSMAsciitable (handle: sINTEGER; VAR ascii, style: SYSTEM.ADDRESS);
  362. VAR p: POINTER TO SYSTEM.ADDRESS;
  363. BEGIN
  364.  VDICall(254, 0, 0, 0, handle);
  365.  p:= SYSTEM.ADR (VDIIntOut[0]); ascii:= p^;
  366.  p:= SYSTEM.ADR (VDIIntOut[2]); style:= p^;
  367. END GetFSMAsciitable;
  368.  
  369. PROCEDURE GetFSMCachesize (handle, cache: sINTEGER): lCARDINAL;
  370. VAR p: POINTER TO lCARDINAL;
  371. BEGIN
  372.  VDIIntIn[0]:= cache;
  373.  VDICall(255, 0, 1, 0, handle);
  374.  p:= SYSTEM.ADR (VDIIntOut[0]);
  375.  RETURN p^;
  376. END GetFSMCachesize;
  377.  
  378. PROCEDURE GetBitmapinfo (handle, char: sINTEGER; VAR info: ARRAY OF LOC);
  379. VAR p: POINTER TO SYSTEM.ADDRESS;
  380. BEGIN
  381.  VDIIntIn[0]:= char;
  382.  p:= SYSTEM.ADR (VDIIntIn[1]); p^:= SYSTEM.ADR (info);
  383.  VDICall(239, 0, 0, 3, handle);
  384. END GetBitmapinfo;
  385.  
  386. PROCEDURE EnableBezier (handle: sINTEGER): sINTEGER;
  387. BEGIN
  388.  VDICall(11, 1, 0, 13, handle);
  389.  RETURN VDIIntOut[0];
  390. END EnableBezier;
  391.  
  392. PROCEDURE DisableBezier (handle: sINTEGER);
  393. BEGIN
  394.  VDICall(11, 0, 0, 13, handle);
  395. END DisableBezier;
  396.  
  397. PROCEDURE BezierBuffer (handle: sINTEGER; buff: SYSTEM.ADDRESS; words: sINTEGER);
  398. VAR p: POINTER TO SYSTEM.ADDRESS;
  399. BEGIN
  400.  p:= SYSTEM.ADR (VDIIntIn[0]);
  401.  p^:= buff;
  402.  VDIIntIn[2]:= words;
  403.  VDICall(-1, 0, 0, 6, handle);
  404. END BezierBuffer;
  405.  
  406. PROCEDURE Bezier (handle, count: sINTEGER;
  407.                   VAR xyarr, bezarr, extent: ARRAY OF LOC;
  408.                   VAR totpts, totmoves: sINTEGER);
  409. VAR oIntin, oPtsin, oIntout, oPtsout: SYSTEM.ADDRESS;
  410. BEGIN
  411.  oIntin:=  VDIPB.intin;  VDIPB.intin:=  SYSTEM.ADR (bezarr);
  412.  oPtsin:=  VDIPB.ptsin;  VDIPB.ptsin:=  SYSTEM.ADR (xyarr);
  413.  oPtsout:= VDIPB.ptsout; VDIPB.ptsout:= SYSTEM.ADR (extent);
  414.  VDICall(6, count, (count + 1) DIV 2, 13, handle);
  415.  totpts:= VDIIntOut[0];
  416.  totmoves:= VDIIntOut[1];
  417.  VDIPB.intin:= oIntin;
  418.  VDIPB.ptsin:= oPtsin;
  419.  VDIPB.ptsout:= oPtsout;
  420. END Bezier;
  421.  
  422. PROCEDURE FilledBezier (handle, count: sINTEGER;
  423.                         VAR xyarr, bezarr, extent: ARRAY OF LOC;
  424.                         VAR totpts, totmoves: sINTEGER);
  425. VAR oIntin, oPtsin, oIntout, oPtsout: SYSTEM.ADDRESS;
  426. BEGIN
  427.  oIntin:=  VDIPB.intin;  VDIPB.intin:=  SYSTEM.ADR (bezarr);
  428.  oPtsin:=  VDIPB.ptsin;  VDIPB.ptsin:=  SYSTEM.ADR (xyarr);
  429.  oPtsout:= VDIPB.ptsout; VDIPB.ptsout:= SYSTEM.ADR (extent);
  430.  VDICall(9, count, (count + 1) DIV 2, 13, handle);
  431.  totpts:= VDIIntOut[0];
  432.  totmoves:= VDIIntOut[1];
  433.  VDIPB.intin:= oIntin;
  434.  VDIPB.ptsin:= oPtsin;
  435.  VDIPB.ptsout:= oPtsout;
  436. END FilledBezier;
  437.  
  438. PROCEDURE BezierQuality (handle, percent: sINTEGER): sINTEGER;
  439. BEGIN
  440.  VDIIntIn[0]:= 0; VDIIntIn[1]:= 0; VDIIntIn[2]:= percent;
  441.  VDICall(5, 0, 3, 99, handle);
  442.  RETURN VDIIntOut[0];
  443. END BezierQuality;
  444.  
  445. END MagicFSM.
  446.  
  447.